#!/usr/bin/perl -wc

package RFCMail::ESMTP::Grammar::Generator;

use strict;
use base qw(Exporter);
use Carp qw(croak);
use RFCMail::Common::Grammar qw(is_quotable
				encode_quoted_string_nsc);
use RFCMail::ESMTP::Grammar::Base qw(ATOM_RE
				     DOT_STRING_RE
				     ESMTP_KEYWORD_RE
				     ESMTP_VALUE_RE);


our @EXPORT =
    qw(
       encode_string
       encode_string_nsc
       encode_local_part
       encode_local_part_nsc
       encode_esmtp_param
       encode_esmtp_param_nsc
       encode_extended_domain
      );


sub syntax_error {
    croak("Argument to ", (caller(1))[3], "() is not of the required type");
}


sub encode_string_nsc {
    return ($_[0])
	if $_[0] =~ /\A@{[ATOM_RE]}\z/o;
    return (&encode_quoted_string_nsc);
}


sub encode_string {
    &syntax_error unless &is_quotable;
    return (&encode_string_nsc);
}


sub encode_local_part_nsc {
    return ($_[0])
	if $_[0] =~ /\A@{[DOT_STRING_RE]}\z/o;
    return (&encode_quoted_string_nsc);
}


sub encode_local_part {
    &syntax_error unless &is_quotable;
    return (&encode_local_part_nsc);
}


sub encode_esmtp_param_nsc {
    my ($keyword, $value) = @_;
    return (defined($value) ? "$keyword=$value" : $keyword);
}


sub encode_esmtp_param {
    my ($keyword, $value) = @_;
    &syntax_error unless $keyword =~ /\A@{[ESMTP_KEYWORD_RE]}\z/o;
    if (defined($value)) {
	&syntax_error unless $value =~ /\A@{[ESMTP_VALUE_RE]}\z/o;
    }
    return (&encode_esmtp_param_nsc);
}


sub encode_extended_domain {
    my ($greet, $addr, $name) = @_;
    return ($greet)
	if not $addr;
    my $tcp_info = $name ? "($name [$addr])" : "([$addr])";
    return ("$greet $tcp_info");
}


1;
